home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
VLN_20
/
ARITHM2.INC
next >
Wrap
Text File
|
1995-03-30
|
19KB
|
777 lines
{))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.BigSHL {}(cnt : integer);
{))))))))))))))))))))))))))))))))}
var i: integer;
begin
if cnt+count>max then
begin
messagebox(0,'Shift Left too far', ' Arithmetic Error', 0 );
exit;
end;
for i := count downto 1 do
tVLN[i+cnt]:= tVLN[i];
for i := 1 to cnt do
tVLN[i] := 0;
count := count + cnt;
end;
{))))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.MultiSHL {}(sf_cnt : integer);
{))))))))))))))))))))))))))))))))))} {shift data left n bits}
var
i, BigCnt : integer;
new,
wLeft, wRight : word;
begin
if (count = 0) or (sf_cnt=0) then exit;
BigCnt := sf_cnt shr 4;
sf_cnt := sf_cnt and $F;
new := 0;
for i := count downto 1 do
begin
wLeft := (tVLN[i] shl sf_cnt) ;
wRight := tVLN[i] shr (16-sf_cnt);
tVLN[i+1] := new or wRight; { combine them }
new := wLeft;
end;
inc(count); Recount;
if max<count then
begin
callError('shl too big error');
exit;
end;
tVLN[1]:= new; {lowest term }
if BigCnt>0 then
BigShl(BigCnt);
end;
{)))))))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.Shr1Bit; {}
{)))))))))))))))))))))))))))))))))))))}
var i : integer;
begin
if count=0 then exit; {not an error }
for i := 1 to count-1 do
begin
tVLN[i] := tVLN[i] shr 1;
if odd(tVLN[i+1]) then inc(tVLN[i],$8000);
end;
tVLN[count] := tVLN[count] shr 1;
end;
{)))))))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.ShL1Bit; {}
{)))))))))))))))))))))))))))))))))))))}
var i : integer;
tmp : boolean;
begin
tmp := (tVLN[count] and $8000 <> 0);
for i := count downto 1 do
begin
if (tVLN[i] and $8000 <> 0) then
inc(tVLN[i+1]);
tVLN[i] := tVLN[i] shl 1;
end;
if tmp then
begin
inc(count);
tVLN[count]:= 1;
end;
if max<count then
begin
callError('shl too big error');
exit;
end;
end;
{)))))))))))))))))))))))))))))))))))))}
{} function tVryLrgNo.FindDivShift {} (other : pVryLrgNo) : integer;
{)))))))))))))))))))))))))))))))))))))}
var
n : integer;
wo, ws : longint;
begin
{compare MS Word of each }
{Shl til bigger then shr til smaller}
wo := other^.tVLN[other^.count];
ws := tVLN[count];
n := 0;
while (wo>ws) do { avoid overflow }
begin
ws := ws shl 1;
inc(n);
end;
while wo<=ws do {make ws slightly smaller }
begin
ws := ws shr 1;
dec(n);
end;
FindDivShift := n+1;
end;
{))))))))))))))))))))))))))))))))))))}
{} function tVryLrgNo.FindnoBinDig {} : integer;
{))))))))))))))))))))))))))))))))))))}
{ how many binary digits }
var
tmpc : integer;
tmpw : word;
begin
Recount; { possibly remove zero words from the top }
tmpw := tVLN[count];
tmpc := 0;
while tmpw > 0 do
begin
tmpw := tmpw shr 1;
inc(tmpc);
end;
FindnoBinDig := tmpc + (count-1) * 16;
end;
{)))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.Copy {} ( other : pVryLrgNo );
{)))))))))))))))))))))))))))))))))}
{ copy other into self }
var i : integer;
begin
if max<other^.count then
begin
callError('copy too big error');
exit;
end;
count := other^.count;
sign := other^.sign;
for i := 1 to count do
tVLN[i] := other^.tVLN[i];
end;
{))))))))))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.TwosComplAbs {}( cnt : integer );
{))))))))))))))))))))))))))))))))))))))}
var
StillZero : boolean;
i : integer;
begin
StillZero := true;
for i := 1 to cnt do
if StillZero then
begin
if tVLN[i] <> 0 then begin
tVLN[i] := - tVLN[i];
StillZero := false;
end;
end
else tVLN[i] := (- tVLN[i] -1);
end;
{)))))))))))))))))))))))))}
{} function IsEqAbs {}(n1, n2 : pVryLrgNo): boolean;
{)))))))))))))))))))))))))}
var
i , j , k : integer;
IGA : boolean;
begin
IsEqAbs := true; {assume true}
n1^.Recount; n2^.Recount;
if n1^.count <> n2^.count then
begin
IsEqAbs := false;
exit;
end;
for i := n1^.count downto 1 do;
if n1^.tVLN[i] <> n2^.tVLN[i] then
begin
IsEqAbs := false;
exit;
end;
end;
{)))))))))))))))))))))))))))}
{} function IsGrEqAbs {}(n1, n2 : pVryLrgNo): boolean;
{)))))))))))))))))))))))))))}
{ is n1 >= n2 ,ignore sign, assume both positive}
var
k : integer;
IGA : boolean;
begin
n1^.Recount; n2^.Recount;
IsGrEqAbs := not (n1^.count < n2^.count); { first apprx. }
if n1^.count = n2^.count then {almost the same }
{ same number of terms}
for k := n1^.count downto 1 do
begin
if (n1^.tVLN[k] < n2^.tVLN[k]) then
begin
IsGrEqAbs := false;
break;
end;
if (n1^.tVLN[k] > n2^.tVLN[k]) then
break;
end;
end;
{)))))))))))))))))))))))))))))))}
{} procedure AddWordArrays {}( t1, t2 : pWordArray;
{)))))))))))))))))))))))))))))))}
var c1, c2 : integer); { t2 + t1 --> t2 }
{input word arrays and counts }
var
i , carry, realcount,
msbs_pre : integer;
begin
carry := 0;
realcount := MaxOfW(c1,c2);
for i := c1 +1 to realcount do
t1^[i] := 0; {we want to add all terms, clear higher }
for i := c2 +1 to realcount do
t2^[i] := 0;
if c1 > 0 then { at least adder > 0 }
for i := 1 to realcount do begin
msbs_pre := (t1^[i] and $8000 ) shr 1
+ (t2^[i] and $8000 );
t2^[i] := t2^[i] + t1^[i] + carry;
case msbs_pre shr 1 of
$6000 : carry := 1;
0 : carry := 0;
else if (t2^[i] and $8000 = 0) then
carry := 1
else carry := 0;
end;
end;
c2 := realcount;
if carry<>0 then begin {after all ordinary terms added}
i := realcount +1;
t2^[i] := 1;
c2 := i;
end;
end;
{(((((((((((((((((((((((((((((((}
{} procedure AddAbsolute {} (n2, n1 : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
{ n1+n2 --> n2}
{ignore sign, assume both positive}
var
i ,ovfl_det, carry, realcount : integer;
begin
carry := 0;
realcount := MaxOfW(n1^.count,n2^.count);
for i := n1^.count +1 to realcount do
n1^.tVLN[i] := 0; {we want to add all terms }
for i := n2^.count +1 to realcount do
n2^.tVLN[i] := 0;
if n1^.count > 0 then { at least adder > 0 }
for i := 1 to realcount do begin
ovfl_det := (n2^.tVLN[i] and $8000 ) shr 1
+ (n1^.tVLN[i] and $8000 );
n2^.tVLN[i] := n2^.tVLN[i] + n1^.tVLN[i] + carry;
case ovfl_det shr 1 of
0 : carry := 0;
$6000 : carry := 1
else
if (n2^.tVLN[i] and $8000 = 0) then
carry := 1
else carry := 0;
end
end;
n2^.count := realcount;
if carry<>0 then begin {after all ordinary terms added}
i := realcount +1;
n2^.tVLN[i] := 1;
n2^.count := i;
end;
if n2^.count>n2^.max then
begin
callError('Add Abs too big error');
exit;
end;
end;
{(((((((((((((((((((((((((((((((}
{} procedure SubAbsolute {} (n2, n1 : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
{ n2-n1 --> n2}
{ignore sign, assume both positive, n2>=n1}
{ assume n2 >= n1 >= 0}
var
i , borrow, realcount,
ovfl_det : integer;
begin
borrow := 0;
realcount := MaxOfW(n1^.count,n2^.count);
for i := n1^.count +1 to realcount do
n1^.tVLN[i] := 0; {we want to sub all terms }
for i := n2^.count +1 to realcount do
n2^.tVLN[i] := 0;
if n1^.count > 0 then { if something in subt' }
for i := 1 to realcount do begin
ovfl_det := (n1^.tVLN[i] and $8000 ) shr 1
+ (n2^.tVLN[i] and $8000 );
n2^.tVLN[i] := n2^.tVLN[i] - n1^.tVLN[i] - borrow;
case ovfl_det shr 1 of
$4000 : borrow := 0;
$2000 : borrow := 1
else
if (n2^.tVLN[i] and $8000 = 0) then
borrow := 0
else borrow := 1;
end
end;
n2^.recount;
if n2^.count>n2^.max then
begin
callError('Sub Abs too big error');
exit;
end;
end;
{(((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.addBy {}(other : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
var i : integer;
begin
if ((sign +other^.sign) <> 0) then
{ does second term reinforce first term}
AddAbsolute( @self, other) { me := me + other }
else if IsGrEqAbs(@self, other) then begin
{ does first term dominate }
SubAbsolute( @self, other);
Recount;
end
else begin
SubAbsolute( @self, other);
TwosComplAbs(other^.count); {how many terms neeeded}
sign := - sign;
Recount;
end;
end;
{(((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.subBy {} (other : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
var i : integer;
begin
if ((sign +other^.sign) = 0) then
{ does second term reinforce first term}
AddAbsolute( @self, other) { me := me - other }
else if IsGrEqAbs(@self, other) then begin
{ does first term dominate }
SubAbsolute( @self, other);
Recount;
end
else begin
SubAbsolute( @self, other);
TwosComplAbs(other^.count); {how many terms neeeded}
sign := - sign;
Recount;
end;
end;
{(((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.mulBy {}(other : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
var
long1, long2 : longint;
tempAccum : longint;
i1, i2,
c0, s0 : integer;
shifter, ovfl_det : integer;
answer_sign : integer;
begin
answer_sign := sign * other^.sign;
{ sign := 1;
other^.sign := 1;
}
for i1 := 1 to wksize do
begin
vlnVars[91]^.tVLN[i1] := 0;
vlnVars[96]^.tVLN[i1] := 0;
end; { clear acumulators}
if (count + other^.count > max ) then
begin
messagebox(0,'multiply too big', ' Arithmetic Error', 0 );
exit;
end;
for i1 := 1 to other^.count do
{this 'other' term by each of the self terms}
for i2 := 1 to count do begin
long1 := longint(tVLN[i2]) *
longint(other^.tVLN[i1]);
shifter := i1+i2 ; { pick destination position }
tempAccum := vlnVars[91]^.tVLN[shifter];
ovfl_det := ((tempAccum and $8000 ) shr 15)
+ ((long1 shr 16) and $8000 ) shr 14;
tempAccum := tempAccum shl 16 +
vlnVars[91]^.tVLN[shifter-1] ;
inc(tempAccum, long1); { add in this terms}
vlnVars[91]^.tVLN[shifter-1] := tempAccum and $FFFF;
vlnVars[91]^.tVLN[shifter] := (tempAccum shr 16) and $FFFF;
if (ovfl_det = 3) or
( (ovfl_det<>0) and
(tempAccum and $80000000 = 0))
then
inc(vlnVars[96]^.tVLN[shifter+1]);
end;
count := count + other^.count;
c0 := count;
sign := answer_sign;
AddWordArrays( @vlnVars[96]^.tVLN[1],
@vlnVars[91]^.tVLN[1], c0, count );
SetVal( count, sign, @vlnVars[91]^.tVLN[1]);
{ put answer away }
Recount;
end;
{(((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.divBy {} ( dvsr,
{(((((((((((((((((((((((((((((((} remnd : pVryLrgNo);
var i, SAdj,
BShf, emptyBits,
sizeOfQ : integer;
dcnt : integer;
answer_sign : integer;
begin
vlnVars[94]^.copy(dvsr);
answer_sign := sign * dvsr^.sign;
sign := 1;
vlnVars[94]^.sign := 1; { work with positive values }
dcnt := vlnVars[94]^.count;
vlnVars[97]^.Clear(Count);
remnd^.clear(Count);
BShf := count - dcnt;
if (BShf<0 ) or
((BShf=0) and
(dvsr^.tVLN[dcnt]>=tVLN[dcnt]) ) then
begin {divisor >= dividend }
remnd^.copy(@self);
remnd^.recount;
Count := 0;
exit;
end;
SAdj := vlnVars[94]^.FindDivShift(@self); {returns -15 to +15}
{number of bits to shift divisor}
if SAdj<0 then
begin
SAdj := 16 + SAdj;
dec(BShf); { dvsr starts smaller then dividend }
end;
vlnVars[94]^.BigShl(BShf); {shift divisor into position}
vlnVars[94]^.MultiSHL(SAdj);
emptybits := BShf * 16 + SAdj;
{zeros at bottom of divisor}
sizeOfQ := 0;
vlnVars[94]^.Recount;
while emptybits >= 0 do
begin
vlnVars[97]^.ShL1Bit;
while IsGrEqAbs(@self,vlnVars[94]) do
{ make sure that we have to shift}
begin {subtract again }
subBy(vlnVars[94]);
inc(vlnVars[97]^.tVLN[1],1); {put a bit into the answer }
end;
vlnVars[97]^.count := (sizeOfQ+16) div 16;
dec(emptybits);
if emptybits>=0 then
vlnVars[94]^.Shr1Bit;
vlnVars[94]^.Recount;
inc(sizeOfQ);
end;
Recount;
remnd^.copy(@self);
vlnVars[97]^.sign := answer_sign;
remnd^.sign := answer_sign;
vlnVars[97]^.Recount;
copy(vlnVars[97]);
end;
{((((((((((((((((((((((((((((((((}
{} function FastDiv {} ( dvnd , dvsr : integer ) : integer;
{(((((((((((((((((((((((((((((((}
var BitsN, BitsD, BitsQ,
BitsDiff : integer;
CntN, CntD : integer;
TopN, TopD : longint;
begin
BitsN := GetBinSize(dvnd);
BitsD := GetBinSize(dvsr);
BitsDiff := BitsN-BitsD;
if (BitsDiff < 0 ) then FastDiv := 0
else if BitsDiff > 13 then FastDiv := - BitsDiff
else { range is such that we can get integer divisor }
begin
CntN := vlnVars[dvnd]^.count;
CntD := vlnVars[dvsr]^.count;
TopN := vlnVars[dvnd]^.tvln[CntN];
if CntN = CntD then
TopD := vlnVars[dvsr]^.tvln[CntD]
else TopD := 0;
{ normalize using top 8-15 bits as integers }
{ we know that TopD has equal or fewer sig bits }
{ we need several signif bits }
if cntN > 1 then
begin
TopN := TopN shl 15
+ vlnVars[dvnd]^.tvln[CntN-1] shr 1;
TopD := TopD shl 15
+ vlnVars[dvsr]^.tvln[CntN-1] shr 1;
end;
FastDiv := TopN div TopD;
end;
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.MulN {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
vlnVars[91]^.SetSmall(n);
MulBy(vlnVars[91]);
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.AddN {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
vlnVars[91]^.SetSmall(n);
AddBy(vlnVars[91]);
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.SubN {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
vlnVars[91]^.SetSmall(n);
SubBy(vlnVars[91]);
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.DivN {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
vlnVars[91]^.SetSmall(n);
DivBy(vlnVars[91], vlnVars[90]);
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.TwoNth {} (n:integer );
{((((((((((((((((((((((((((((((((}
var
i : integer;
begin
sign := 1;
if n<= 0 then
begin
SetSmall(1);
exit;
end;
count := n shr 4 +1;
n := n mod 16; {up to 15 additional bits}
if count > max then
begin
messagebox(0,'Two Nth too big', ' Arithmetic Error', 0 );
exit;
end;
for i := 1 to count-1 do
tvln[i] := 0;
tvln[count] := 1 shl n;
sign := 1;
end;
{((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.TenNth {} (n:integer );
{((((((((((((((((((((((((((((((((}
var
i : integer;
begin
sign := 1;
SetSmall(10); { + 10 }
if n<= 0 then
SetSmall(1)
else
begin
if n>1 then NthPower(n);
end;
end;
{((((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.NthPower {}(n:integer );
{((((((((((((((((((((((((((((((((((}
var
i : integer;
begin
vlnVars[90]^.Copy(@self);
for i := 1 to n-1 do
MulBy(vlnVars[90]);
end;
{((((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.FastNthPower {}(n:integer );
{((((((((((((((((((((((((((((((((((} { may use registers 50-62 }
procedure SetMultipliers;
var base, a : integer;
begin
base := 90;
vlnVars[base]^.Copy(@self);
vlnVars[base]^.MulBy(@self);{ this is squared power}
a := n ;
while a > 1 do
begin
vlnVars[base-1]^.Copy(vlnVars[base]); { higher power by 2}
vlnVars[base-1]^.MulBy(vlnVars[base]);
dec(base);
a := a shr 1;
end;
end;
{- - - - - - - - - - - local subs - - - - - - - }
var
base : integer;
begin
if (n <= 0) or (n>=2048) then exit;
SetMultipliers;
base := 91;
if not odd(n) then
begin
while not odd(n) do
begin
n := n shr 1;
dec(base);
end;
self.Copy(vlnVars[base]); { first term found }
end;
while n > 1 do begin
n := n shr 1;
dec(base);
if odd(n) then
self.MulBy(vlnVars[base]);
end;
end;
{(((((((((((((((((((((((((((((((((}
{} procedure tVryLrgNo.NthRoot {} (n:integer );
{(((((((((((((((((((((((((((((((((}
var i,j,rcnt : integer;
sg, MLimit: integer;
IsDone, DeltaZero : boolean;
{ Binary Search }
begin
rcnt := FindnoBinDig div n + 1;
vlnVars[94]^.TwoNth(rcnt-1); { running bit inserter }
vlnVars[97]^.SetSmall(0) ; {clear answer }
while rcnt >= 0 do
begin
vlnVars[97]^.AddBy(vlnVars[94]); {establish next guess}
vlnVars[98]^.Copy(vlnVars[97]); { a copy of the guess }
if n > 3 then
vlnVars[98]^.FastNthPower(n)
else vlnVars[98]^.NthPower(n);
{ Guess^Nth power }
if not IsGrEqAbs ( @self , vlnVars[98] ) then {too big ??}
vlnVars[97]^.SubBy(vlnVars[94]); {take away latest}
dec(rcnt);
vlnVars[94]^.TwoNth(rcnt); { running bit inserter }
end; { while }
Copy(vlnVars[97]); { return answer }
end;